home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / widgetText.tcl.z / widgetText.tcl
Text File  |  2002-07-08  |  10KB  |  350 lines
  1. # widgetText.tcl
  2. #
  3. # Layer over the TK text widget that provides contrained scrolling
  4. # and 1-to-1 draging.
  5. #
  6. # Based on code contributed by John Robert Loverso
  7. #
  8. # Copyright (c) 1993 Xerox Corporation.
  9. # Use and copying of this software and preparation of derivative works based
  10. # upon this software are permitted. Any distribution of this software or
  11. # derivative works must comply with all applicable United States export
  12. # control laws. This software is made available AS IS, and Xerox Corporation
  13. # makes no warranty about the software, its performance or its conformity to
  14. # any specification.
  15.  
  16. proc Widget_TextInit {} {
  17.     # Preferences stuff moved to exwin.tcl
  18.     # for the sake of the user interface.
  19. }
  20. proc Widget_TextInitText {t} {
  21.     global widgetText        ;# Constrained scrolling module
  22.     set widgetText($t,geo) {}
  23.     global TextType        ;# Text bindings module
  24.     set TextType($t) text
  25. }
  26. proc Widget_Text {frame height args} {
  27.     # Create the text widget used to display messages
  28.     global exwin
  29.     if ![info exists exwin(scrollbarSide)] {
  30.     set side right
  31.     } else {
  32.     set side $exwin(scrollbarSide)
  33.     }
  34.     if ![info exists exwin(hscrollbarSide)] {
  35.     set hside none
  36.     } else {
  37.     set hside $exwin(hscrollbarSide)
  38.     }
  39.     if { $hside == "none" } {
  40.         set cmd [list text $frame.t -relief raised -bd 2  \
  41.         -yscroll [list WidgetScrollSet $frame.sv $frame.t]]
  42.     } else {
  43.     set cmd [list text $frame.t -relief raised -bd 2  \
  44.         -yscroll [list WidgetScrollSet $frame.sv $frame.t] \
  45.         -xscroll [list WidgetScrollSet $frame.sh $frame.t]]
  46.     }
  47.     if [catch [concat $cmd $args] t] {
  48.     puts stderr "Widget_Text (warning) $t"
  49.     set t [eval $cmd $args {-font fixed}]
  50.     }
  51.     if {[option get $frame.t width Width] == {}} {
  52.     $frame.t configure -width 80
  53.     }
  54.     if {[option get $frame.t height Height] == {}} {
  55.     $frame.t configure -height $height
  56.     }
  57.     scrollbar $frame.sv -command [list WidgetTextYview $t]
  58.  
  59.     if { $hside != "none" } {
  60.     scrollbar $frame.sh -command "$frame.t xview" -orient horizontal
  61.     pack append $frame $frame.sv [list $side filly] \
  62.         $frame.sh [list $hside fillx] $t {expand fill}
  63.     } else {
  64.     pack append $frame $frame.sv [list $side filly] $t {expand fill}
  65.     }
  66.  
  67.     $t mark set insert 0.0
  68.  
  69.     Widget_TextInitText $t    ;# Init state variables
  70.  
  71.     if [regexp {setgrid} $args] {
  72.     wm minsize [winfo toplevel $frame] 10 1
  73.     }
  74.  
  75.     return $t
  76. }
  77. proc Widget_TextPageOrNext {t {implied implied}} {
  78.     global widgetText
  79.     set next 0
  80.     set bottom [lindex [$t yview] 1]
  81.     set next [expr $bottom >= 1]
  82.     if {$next && $widgetText(autoNext) } {
  83.     Ftoc_NextImplied show $implied
  84.     } else {
  85.     Widget_TextPageDown $t
  86.     }
  87. }
  88. proc Widget_TextPageDown {t} {
  89.     global widgetText
  90.     WidgetTextYview $t scroll 1 pages
  91.     $t mark set insert @1,1
  92. }
  93. proc Widget_TextPageUp {t} {
  94.     global widgetText
  95.     WidgetTextYview $t scroll -1 pages
  96.     $t mark set insert @1,1
  97. }
  98. proc Widget_TextLineDown {t} {
  99.     global widgetText
  100.     $t yview scroll 1 units
  101. }
  102. proc Widget_TextLineUp {t} {
  103.     global widgetText
  104.     $t yview scroll -1 units
  105. }
  106. proc Widget_TextTop {t} {
  107.     $t see 1.0
  108. }
  109. proc Widget_TextBottom {t} {
  110.     $t see end
  111. }
  112. proc WidgetTextYview4.0 {w args} {
  113.     global widgetText
  114.     set dir [lindex $args 1]
  115.     set op  [lindex $args 0]
  116.     set units  [lindex $args 2]
  117.     set view [$w yview]
  118.     set next [expr 1 - [lindex $view 1]]
  119.     set prev [lindex $view 0]
  120.     set span [expr 1. - $next - $prev]
  121.     if {!$widgetText(smoothScroll) ||
  122.     ($op != "scroll") ||
  123.     ($units != "pages") ||
  124.         ($dir > 0 && $next >= $span) ||
  125.         ($dir < 0 && $prev >= $span)} {
  126.         eval $w yview $args
  127.     } else {
  128.         while {($dir > 0 && $next > 0) ||
  129.                 ($dir < 0 && $prev > 0)} {
  130.             $w yview scroll [expr ($dir > 0) ? 2 : -2] unit
  131.             update idletasks
  132.             set view [$w yview]
  133.             set next [expr 1 - [lindex $view 1]]
  134.             set prev [lindex $view 0]
  135.         }
  136.     }
  137. }
  138. proc WidgetTextYview {t args} {
  139.     global widgetText
  140.     return [eval WidgetTextYview4.0 $t $args]
  141.     if {!$widgetText(constrained) &&
  142.      !($widgetText(constrainFtoc) && [string match *.ftoc.* $t])} {
  143.     eval {$t yview} $args
  144.     return
  145.     }
  146.     set mark $args
  147.     if {([llength $args] == 1) && ([scan $args %d line] == 1)} {
  148.     if {[string compare $line $args] == 0} {
  149.         # Being invoked as a scrollcommand, in which lines are
  150.         # counted from 0.  incr to get back to mark coordinates.
  151.         incr line
  152.         set mark $line.0
  153.     }
  154.     }
  155.     if {[lindex $args 0] == "-pickplace"} {
  156.     set pick -pickplace
  157.     set mark [lrange $args 1 end]
  158.     } else {
  159.     set pick {}
  160.     }
  161.     if [$t compare $mark > end] {
  162.     set mark end
  163.     }
  164.     eval {$t yview} $pick {$mark}
  165.     set height [lindex [split [winfo geometry $t] +x] 1]
  166.     set bot [$t index @0,$height]
  167.     set end [$t index end]
  168.     if {$bot != $end} {
  169.     return
  170.     }
  171.     set max [lindex [$t config -height] 4]
  172.     set i 0
  173.     while {$bot == $end} {
  174.     set mark [$t index [list $mark -1 lines]]
  175.     $t yview $mark
  176.     set bot [$t index @0,$height]
  177.     incr i
  178.     if {$i > $max} {
  179.         return    ;# message smaller than window
  180.     }
  181.     }
  182.     set mark [$t index [list $mark +1 lines]]
  183.     $t yview $mark
  184. }
  185. proc WidgetScrollSet {s t args} {
  186.     global widgetText
  187.     set widgetText($t,view) $args
  188.     if {$s != {}} {
  189.     if [catch {eval {$s set} $args} err] {
  190.         Exmh_Debug WidgetScrollSet $err
  191.     }
  192.     }
  193. }
  194. proc WidgetTextMark {t y} {
  195.     global widgetText
  196. #    Exmh_Debug WidgetTextMark $t $y
  197.     set widgetText($t,mark) $y            ;# Remember mark point
  198.     scan [$t index @1,1] %d widgetText($t,top)    ;# and starting top line
  199. }
  200. proc WidgetTextDragto {t y speed} {
  201.     global widgetText
  202.     if ![info exists widgetText($t,mark)] {
  203.     return
  204.     }
  205.     if {$y == $widgetText($t,mark)} {
  206.     return
  207.     }
  208. #    Exmh_Debug WidgetTextDragto $t $y
  209.     set gridy [WidgetTextGridY $t]
  210.     set dy [expr {($widgetText($t,mark)-$y)*$speed}]
  211.     set dlines [expr $dy/$gridy]
  212.     set rem [expr $dy%$gridy]
  213.     if {$dy < 0} {
  214.     incr dlines
  215.     set rem [expr $rem-$gridy]
  216.     }
  217.     if {$dlines >= 1.0 || $dlines <= -1.0} {
  218.     set widgetText($t,mark) [expr $y+$rem]
  219.     set newtopline [expr $widgetText($t,top)+$dlines]
  220.     WidgetTextYview $t $newtopline.0
  221.     set widgetText($t,top) $newtopline
  222.     }
  223. }
  224. proc WidgetTextGridY {t} {
  225.     global widgetText
  226.     set geo [split [winfo geometry $t] +x]
  227.     if ![info exists widgetText($t,geo)] {
  228.     set widgetText($t,geo) 0
  229.     }
  230.     if { [string compare $geo $widgetText($t,geo)] != 0 } {
  231.     # Reverse engineer grid size - broken for windows that get resized.
  232.     set widgetText($t,geo) $geo
  233.     set h [lindex $geo 1]
  234.     set nlines [lindex [$t config -height] 4]
  235.     set widgetText($t,gridY) [expr $h/$nlines]
  236.     Exmh_Debug widgetText($t,gridY) $widgetText($t,gridY)
  237.     }
  238.     return $widgetText($t,gridY)
  239. }
  240. proc WidgetTextSelBegin {w x y how} {
  241.     WidgetTextSelStart $w @$x,$y $how
  242. }
  243. proc WidgetTextSelStart {w mark how} {
  244.     global widgetText
  245.     set widgetText($w,extend) 0
  246.     switch -- $how {
  247.     char {Text_SetInsert $w $mark}
  248.     word {Text_WordSelect $w $mark}
  249.     line {Text_LineSelect $w $mark}
  250.     }
  251. }
  252. proc WidgetTextSelAgain {w x y} {
  253.     global widgetText
  254.     set widgetText($w,extend) 0
  255.     tk_textResetAnchor $w @$x,$y
  256.     Text_SelectTo $w @$x,$y
  257. }
  258. proc WidgetTextSelMotion {w x y} {
  259.     global widgetText
  260.  
  261.     if ![info exists widgetText($w,extend)] {
  262.     return
  263.     }
  264.     set active $widgetText($w,extend)
  265.  
  266.     set h [winfo height $w]
  267.     if {$y > $h} {
  268.     set widgetText($w,extend) [expr $y-$h]
  269.     } else {
  270.     if {$y < 0} {
  271.         set widgetText($w,extend) $y
  272.     } else {
  273.         set widgetText($w,extend) 0
  274.     }
  275.     }
  276.     
  277.     if {$widgetText($w,extend) == 0} {
  278.     Text_SelectTo $w @$x,$y
  279.     } else {
  280.     if {! $active} {
  281.         set widgetText($w,lastmark) [$w index @$x,$y]
  282.         after $widgetText(selectDelay) [list WidgetTextSelExtend $w]
  283.     }
  284.     }
  285. }
  286. proc WidgetTextSelExtend {w} {
  287.     global widgetText
  288.  
  289.     if {![info exists widgetText($w,extend)] ||
  290.     ($widgetText($w,extend) == 0)} {
  291.         return
  292.     }
  293.     set delta [expr {$widgetText($w,extend) / 16}]
  294.     if {$delta == 0} {
  295.     set delta [expr { ($widgetText($w,extend) < 0) ? -1 : 1 }]
  296.     }
  297.     set sign [expr {($delta > 0) ? "+" : ""}]
  298.     catch {
  299.     if [$w compare $widgetText($w,lastmark) <= sel.first] {
  300.         set mark "sel.first $sign $delta lines"
  301.     } else {
  302.         set mark "sel.last $sign $delta lines"
  303.     }
  304.     set widgetText($w,lastmark) [$w index $mark]
  305.     Text_SelectTo $w $mark
  306.     $w yview -pickplace $mark
  307.     after $widgetText(selectDelay) [list WidgetTextSelExtend $w]
  308.     }
  309. }
  310. proc WidgetTextSelDone {w} {
  311.     global widgetText
  312.     catch {unset widgetText($w,extend)}
  313.     Text_SelectionEnd $w 1
  314. }
  315. proc Widget_TextEnd {w} {
  316.     scan [$w index end] %d i
  317.     incr i -2
  318. }
  319.  
  320. proc tk_textResetAnchor {args} {
  321.     eval tkTextResetAnchor $args
  322. }
  323.  
  324. # Fill out the text widget with enough blanks to allow the
  325. # given line to appear at the top.
  326. proc Widget_TextPad {w top} {
  327.     # Assume -height is ok, even though can be wrong after resize
  328.     # set height [$w cget -height]
  329.     #
  330.     # The above replaced by the following, thanks to 
  331.     # Harvey Thompson <harveyt@sco.com> and
  332.     # John Haxby <J.Haxby@isode.com>
  333.  
  334.     # Add newlines so that text in all window
  335.     set limit 100
  336.     while {[$w bbox "end -1c"] != ""} {
  337.     $w insert end \n
  338.     if {[incr limit -1] < 0} {
  339.         break
  340.     }
  341.     }
  342.     # Compute height even if using different fonts
  343.     set height [expr int([$w index @0,65535]) - int([$w index @0,0]) + 1] 
  344.     set last [$w index "end -1c"]
  345.     Exmh_Debug Widget_TextPad h=$height last=$last top=$top
  346.     for {} {$last - $top < $height+1} {set last [expr $last + 1.0]} {
  347.     $w insert end \n
  348.     }
  349. }
  350.